home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #25 (Oct 87) / Forth MiniTerm source / Miniterm.edit < prev   
Text File  |  1987-09-18  |  8KB  |  359 lines
  1. \ routines for hierarchical menu support in Mach2
  2. \ J. Langowski / MacTutor July 1987
  3.  
  4. only forth also assembler also mac also i/o
  5.  
  6. 108 USER TaskMenuBar
  7. 164 USER goaway-hook
  8.  
  9. $4D444546 CONSTANT "mdef
  10. $44525652 CONSTANT "drvr
  11.  
  12. $28E  CONSTANT ROM85
  13. $B5C  CONSTANT MenuMgrType
  14. $A89F CONSTANT undefTrap
  15.  
  16. ( *** menu record data structure *** )
  17.  0 CONSTANT menuID        ( integer )
  18.  2 CONSTANT menuWidth    ( integer )
  19.  4 CONSTANT menuHeight    ( integer )
  20.  6 CONSTANT menuProc    ( handle )
  21. 10 CONSTANT enableFlags ( longint )
  22. 14 CONSTANT menuData    ( Str255 and other data ) 
  23.     ( *** menu Data format *** )
  24.     ( counted string: menu title )
  25.     ( followed by 1 to 31 times: )
  26.     ( counted string: menu item  )
  27.     ( byte: item icon # )
  28.     ( byte: equivalent character )
  29.     ( byte: check mark character )
  30.     ( byte: text attributes )
  31.     ( .... )
  32.     ( end: zero byte. )
  33.  
  34. CODE setitemcmd
  35.     EXG    D4,A7
  36.     MOVE.L    8(A6),-(A7)
  37.     MOVE.W    6(A6),-(A7)
  38.     MOVE.W    2(A6),-(A7)
  39.     ADDA.W    #$C,A6
  40.     _setItemCmd
  41.     EXG    D4,A7
  42.     RTS
  43. END-CODE
  44.  
  45. CODE getitemcmd
  46.     EXG    D4,A7
  47.     MOVE.L    8(A6),-(A7)
  48.     MOVE.W    6(A6),-(A7)
  49.     MOVE.L    (A6),-(A7)
  50.     ADDA.W    #$C,A6
  51.     _getItemCmd
  52.     EXG    D4,A7
  53.     RTS
  54. END-CODE
  55.  
  56. : newrom? rom85 w@ l_ext 0> ;
  57.  
  58. : newmenus? MenuMgrType @ -1 <> ;
  59.  
  60. : getItemCmd?     
  61. $A84E call gettrapaddress undefTrap call gettrapaddress <> ;
  62.  
  63. : MDEF-version "mdef 0 call getresource @ 10 + w@ ;
  64.  
  65. : branch.menu { subID mainID item# | mainmenu submenu -- }
  66.     newrom? 
  67.     newmenus? AND
  68.     getItemCmd? AND
  69.     MDEF-version 9 > AND
  70.     IF    mainID call getMHandle -> mainmenu
  71.         mainmenu 0= abort" Main menu does not exist"
  72.         subID  call getMHandle -> submenu
  73.         submenu 0= abort" Submenu does not exist"
  74.         mainmenu item# subID call setitmmark
  75.         mainmenu item# $1B setItemCmd
  76.     ELSE
  77.         1 abort" System does not support hierarchical menus" 
  78.     THEN
  79. ;
  80.  
  81. Variable baud#
  82. Variable data#
  83. Variable stop#
  84. Variable parity#
  85. Variable hsk#
  86. Variable DAName
  87.  
  88. 400 8000 terminal EMULATOR
  89. NEW.WINDOW TERM
  90. " Terminal" TERM TITLE
  91. 45 25 335 475 TERM BOUNDS
  92. DOCUMENT VISIBLE GROWBOX CLOSEBOX TERM ITEMS
  93.  
  94. NEW.MBAR TermMenuBar
  95.  
  96. 200 CONSTANT Apple_ID
  97. create apple_string $01 c, $14 c,
  98. NEW.MENU Apple_menu
  99. apple_string Apple_menu TITLE
  100. 0 200 Apple_menu BOUNDS
  101. " About Terminal…;(-" Apple_menu ITEMS
  102.  
  103. 300 CONSTANT Term_ID
  104. NEW.MENU Term_menu
  105. " Terminal" Term_menu TITLE
  106. 0 Term_ID Term_menu BOUNDS
  107. " Rate;Format;Parity;Handshake;Quit" Term_menu ITEMS
  108.  
  109. 129 CONSTANT baud_ID
  110. NEW.MENU baud_menu
  111. " Rate" baud_menu TITLE
  112. -1 baud_ID baud_menu BOUNDS \ insert as hierarchical menu
  113. " 300;600;1200;1800;2400;3600;4800;7200;9600;19200" baud_menu ITEMS
  114.  
  115. 130 CONSTANT form_ID
  116. NEW.MENU form_menu
  117. " Format" form_menu TITLE
  118. -1 form_ID form_menu BOUNDS \ insert as hierarchical menu
  119. " 5 data;6 data;7 data;8 data;(-;1 stop;1.5 stop;2 stop" form_menu ITEMS
  120.  
  121. 131 CONSTANT parity_ID
  122. NEW.MENU parity_menu
  123. " Parity" parity_menu TITLE
  124. -1 parity_ID parity_menu BOUNDS \ insert as hierarchical menu
  125. " none;odd;even" parity_menu ITEMS
  126.  
  127. 132 CONSTANT hsk_ID
  128. NEW.MENU hsk_menu
  129. " Handshake" hsk_menu TITLE
  130. -1 hsk_ID hsk_menu BOUNDS \ insert as hierarchical menu
  131. " none;xon-xoff;cts" hsk_menu ITEMS
  132.  
  133. : do.config
  134.     baud# @ CASE
  135.      1 OF $17C ENDOF
  136.      2 OF $BD  ENDOF
  137.      3 OF $5E  ENDOF
  138.      4 OF $3E  ENDOF
  139.      5 OF $2E  ENDOF
  140.      6 OF $1E  ENDOF
  141.      7 OF $16  ENDOF
  142.      8 OF $E   ENDOF
  143.      9 OF $A   ENDOF
  144.     10 OF $4   ENDOF
  145.     ENDCASE
  146.     
  147.     data# @ CASE
  148.      1 OF $0   ENDOF
  149.      2 OF $800 ENDOF
  150.      3 OF $400 ENDOF
  151.      4 OF $C00 ENDOF
  152.     ENDCASE
  153.     +
  154.  
  155.     stop# @ CASE
  156.      6 OF $4000 ENDOF
  157.      7 OF $8000 ENDOF
  158.      8 OF $C000 ENDOF
  159.     ENDCASE
  160.     +
  161.  
  162.     parity# @ CASE
  163.      1 OF $0    ENDOF
  164.      2 OF $1000 ENDOF
  165.      3 OF $3000 ENDOF
  166.     ENDCASE
  167.     +
  168.  
  169.     hsk# @ CASE
  170.      1 OF $0     ENDOF
  171.      2 OF $10000 ENDOF
  172.      3 OF $20000 ENDOF
  173.     ENDCASE
  174.     +
  175.     comm1 MODE IF 10 call sysbeep THEN
  176. ;
  177.  
  178. : init.menus
  179.     TermMenuBar ADD
  180.     TermMenuBar Apple_menu ADD
  181.        Apple_menu @ "drvr CALL AddResMenu 
  182.     TermMenuBar term_menu ADD
  183.     TermMenuBar baud_menu ADD
  184.     TermMenuBar form_menu ADD
  185.     TermMenuBar parity_menu ADD
  186.     TermMenuBar hsk_menu ADD
  187.     baud_ID   term_ID 1 branch.menu
  188.     form_ID   term_ID 2 branch.menu
  189.     parity_ID term_ID 3 branch.menu
  190.     hsk_ID    term_ID 4 branch.menu
  191.     baud_menu   @ 9 -1 call checkitem
  192.     form_menu   @ 4 -1 call checkitem
  193.     form_menu   @ 8 -1 call checkitem
  194.     parity_menu @ 1 -1 call checkitem
  195.     hsk_menu    @ 1 -1 call checkitem
  196.     9 baud# !
  197.     4 data# ! 8 stop# !
  198.     1 parity# ! 1 hsk# !
  199.     do.config
  200. ;
  201.  
  202. : do.about 128 0 CALL alert drop ;
  203.  
  204. : do.apple   { item# }
  205.     \ item# = 1 (About...)?
  206.     item# 1 =                     
  207.     IF    do.about
  208.     ELSE
  209.         Apple_menu @ item# DAName CALL GetItem
  210.         DAName CALL OpenDeskAcc DROP
  211.     THEN ;
  212.  
  213. : do.baud 
  214.     baud_menu @ over -1 call checkitem
  215.     baud_menu @ baud# @ 0 call checkitem
  216.     baud# !
  217. ;
  218.     
  219. : do.format
  220.     form_menu @ over -1 call checkitem 
  221.     dup 5 < IF
  222.         form_menu @ data# @ 0 call checkitem
  223.         data# !
  224.     ELSE
  225.         form_menu @ stop# @ 0 call checkitem
  226.         stop# !
  227.     THEN
  228. ;
  229.  
  230. : do.parity 
  231.     parity_menu @ over -1 call checkitem
  232.     parity_menu @ parity# @ 0 call checkitem
  233.     parity# !
  234. ;
  235. : do.hshake 
  236.     hsk_menu @ over -1 call checkitem
  237.     hsk_menu @ hsk# @ 0 call checkitem
  238.     hsk# !
  239. ;
  240.  
  241. : do.term 
  242.     CASE
  243.     5 OF bye ENDOF
  244.     ENDCASE
  245. ;
  246.  
  247. : termmenuhandler ( item# menuID -- )
  248.     CASE
  249.     apple_ID    OF do.apple  ENDOF
  250.     baud_ID     OF do.baud   ENDOF
  251.     form_ID     OF do.format ENDOF
  252.     parity_ID     OF do.parity ENDOF
  253.     hsk_ID        OF do.hshake ENDOF
  254.     term_ID        OF do.term   ENDOF
  255.     ENDCASE
  256.     do.config
  257.     0 call hilitemenu
  258. ;
  259.  
  260.     
  261.     
  262. ( terminal emulator code from PAS starts here )
  263.  
  264. $0A CONSTANT LINE_FEED        ( ascii 'linefeed' )
  265. $20 CONSTANT SP            ( ascii 'space' )
  266. $14  CONSTANT ctrl-t
  267.  
  268. VARIABLE inputbuffer
  269. 64 VALLOT            ( 68 bytes for holding modem input)
  270.  
  271. : emit>console ( n - )         ( send a single character to the screen )
  272.     CONSOLE OUTPUT
  273.     EMIT ;
  274.  
  275. : emit>modem ( n - )        ( send a single character to the modem port)
  276.     COMM1 OUTPUT
  277.     EMIT ;
  278.  
  279. : ?comm1 ( - n )     ( this word will determine if the Modem Port )
  280.     COMM1 INPUT    ( has received any characters. The number returned )
  281.     ?TERMINAL ;     ( will indicate the number of characters waiting. )
  282.  
  283.  
  284.               
  285. : @comm1 ( - n )     ( this word will read one character from the )
  286.     COMM1 INPUT    ( modem port. If no characters are ready, this )
  287.     KEY ;        ( word will wait. The task will be put to sleep )
  288.             ( and awaken when the ioCompletion routine is )
  289.             ( executed upon receiving a character. )
  290.  
  291.  
  292. ( type>screen is an enhanced version of the normal TYPE routine. )
  293. ( this word will filter out linefeeds. A linefeed is printed on )
  294. ( the Macintosh as a square box. )
  295.  
  296.  
  297.  
  298. : type>screen { address length }    
  299.     length 0 DO 
  300.     
  301.          address I + C@        ( throw away 8th bit )
  302.          $7F AND
  303.          address I + C!
  304.          
  305.          address I + C@ LINE_FEED =    ( look for a Linefeed)
  306.             IF
  307.                 sp address I + C!   ( replace LF with SP)
  308.             THEN
  309.          LOOP
  310.          CONSOLE OUTPUT    
  311.          address length TYPE ;        ( type out the modified string)
  312.  
  313.  
  314. : monitor-modem { | temp }
  315.         ?comm1          ( how many characters are ready ? )
  316.     ?DUP            ( Note: The maximum # of chars must be)
  317.                 ( less than 64. This is the default size)
  318.                 ( of the Serial Driver buffer. )
  319.     IF
  320.         -> temp            ( save number of unread characters )
  321.         COMM1 INPUT
  322.         inputbuffer temp EXPECT    ( receive characters from modem)
  323.         inputbuffer temp type>screen  ( send this string to screen)
  324.     THEN ;
  325.  
  326. : goaway-handler bye ;
  327.  
  328. : PopUp    ( - )
  329.     Term dup CALL showwindow CALL selectwindow ;
  330.  
  331. : start-comm
  332.      ACTIVATE        ( assign the following code to EMULATOR )
  333.      ['] termmenuhandler menu-vector !
  334.      ['] goaway-handler goaway-hook !
  335.          Popup
  336.      termmenubar @ call setmenubar call drawmenubar
  337.      CLS
  338.      CONSOLE OUTPUT ." Ready >" CR
  339.  
  340.      BEGIN
  341.       CONSOLE INPUT    
  342.       ?TERMINAL         ( has the user pressed a key ? )
  343.       IF
  344.         KEY emit>modem     ( send char to modem. 'no local echo' )
  345.       THEN
  346.        monitor-modem    ( watch the serial port)
  347.      AGAIN 
  348. ;
  349.  
  350.  
  351.  
  352. : MODEM    
  353.     term ADD        ( make the term window )
  354.     term EMULATOR BUILD        ( tie the term window
  355.                       to the EMULATOR task )
  356.     init.menus
  357.     TermMenuBar emulator mbar>task
  358.     EMULATOR start-comm ;    ( launch task )
  359.